home *** CD-ROM | disk | FTP | other *** search
- (*---------------------------------------------------------------------------
- :Program. DeviceLock.mod
- :Author. Thomas Wagner
- :Address. Mühlenweg 7, 90602 Pyrbaum, Germany
- :Address. E-Mail: tom@oberon.nbg.sub.org
- :Copyright. © 1994 by Thomas Wagner [tom], see DeviceLock.guide
- :Language. Oberon
- :Translator. Amiga Oberon Compiler V3.11d
- :Import. HotKey.mod V2.0 Thomas Igracki, [tom] (on this disk)
- :Import. MoreIntuition.mod V1.3 [mick] (Amok 78)
- :Import. WBReadArgs.mod V1.0 [hG] (Amok 83)
- :Import. PrintF.mod V1.4 Volker Rudolph, [hG] (Amok 82)
- :Contents. Lock with Intuition-Interface (2.04 or higher ONLY!)
- ---------------------------------------------------------------------------*)
-
- MODULE DeviceLock;
-
- (*-------------------------------------------------------------------------*)
-
- IMPORT c := Conversions,
- d := Dos,
- DLd:= DLdrives,
- DLr:= DLrequester,
- DLs:= DLstrings,
- DLp:= DLprefs,
- e := Exec,
- g := Graphics,
- gt := GadTools,
- hot:= HotKey,
- I := Intuition,
- MI := MoreIntuition,
- ol := OberonLib,
- s := Strings,
- sys:= SYSTEM,
- t := Timer,
- u := Utility;
-
- (*-------------------------------------------------------------------------*)
-
- CONST
-
- comName *= "DeviceLock\o$VER: DeviceLock 1.2 (17.3.94)";
- comTitle *= "DeviceLock, 1.2 © 1994 [tom]";
- comDescr *= "Intuition-Interface for CLI-Lock";
-
- scrtitle = "DeviceLock, 1.2 - © 1994 by Thomas Wagner. All Rights reserved.";
-
- about = "DeviceLock 1.2\n\n"
- "© 1994 by Thomas Wagner, Pyrbaum [tom].\n"
- "%s";
-
- topadd = 5 ;
-
- checkscal = 2421;
-
- (*-------------------------------------------------------------------------*)
-
- TYPE
-
- NewMenus = ARRAY 10 OF gt.NewMenu;
-
- (*-------------------------------------------------------------------------*)
-
- CONST
-
- menuLock = 1;
- menuUnlock = 2;
- menuNorm = 3;
- menuAbout = 4;
- menuHide = 5;
- menuQuit = 6;
-
-
- myNewMenuConst = NewMenus(
- gt.title, NIL, NIL, {}, LONGSET{}, NIL,
- gt.item , NIL, sys.ADR("L"), {}, LONGSET{}, menuLock,
- gt.item , NIL, sys.ADR("U"), {}, LONGSET{}, menuUnlock,
- gt.item , NIL, sys.ADR("U"), {}, LONGSET{}, menuNorm,
- gt.item , gt.barLabel, NIL, {}, LONGSET{}, NIL,
- gt.item , NIL, sys.ADR("?"), {}, LONGSET{}, menuAbout,
- gt.item , gt.barLabel, NIL, {}, LONGSET{}, NIL,
- gt.item , NIL, sys.ADR("H"), {}, LONGSET{}, menuHide,
- gt.item , NIL, sys.ADR("Q"), {}, LONGSET{}, menuQuit,
- gt.end , NIL, NIL, {}, LONGSET{}, NIL);
- (*-------------------------------------------------------------------------*)
-
- VAR
- font : g.TextFontPtr;
- ng : gt.NewGadget;
- glist : I.GadgetPtr;
- gad : I.GadgetPtr;
- vi : e.APTR;
- terminated : BOOLEAN;
- imsg : I.IntuiMessagePtr;
- imsgClass : LONGSET;
- imsgCode : INTEGER;
- count : INTEGER;
- TimerPort : e.MsgPortPtr;
- TimeReq : t.TimeRequestPtr;
- OpenDev : SHORTINT;
- signals : LONGSET;
- allock : BOOLEAN;
- allunlock : BOOLEAN;
- quickquit : BOOLEAN;
- keepquit : BOOLEAN;
- gheight : INTEGER;
- wheight : INTEGER;
- wwidth : INTEGER;
- windowopen : BOOLEAN;
- HotSig : SHORTINT;
- HotType : LONGSET;
- HotID : LONGINT;
- closewin : BOOLEAN;
- myNewMenu : NewMenus;
- menu : I.MenuPtr;
- topborder : INTEGER;
- zoom : ARRAY 4 OF INTEGER;
- force : BOOLEAN;
-
-
- (*------ Append one Gadget to Gadget-List ---------------------------------*)
-
- PROCEDURE * MakeGad(VAR n: DLp.driveT);
- BEGIN
- ng.topEdge := topborder + topadd + 2 + (count)*gheight;
- ng.gadgetText := sys.ADR(n.PrintName);
- ng.gadgetID := count;
- gad := gt.CreateGadget(gt.checkBoxKind, gad, ng,
- I.gaDisabled, sys.VAL(SHORTINT,n.disabled),
- gt.cbChecked, sys.VAL(SHORTINT,n.locked),
- gt.cbScaled, I.LTRUE,
- u.done);
- n.GadPtr:=gad;
- END MakeGad;
-
-
- (*------ Prepare and Send IO ----------------------------------------------*)
-
- PROCEDURE psIO();
- BEGIN
- TimeReq.time.secs := DLp.Prefs.CheckTime;
- TimeReq.time.micro := 0;
- e.SendIO(TimeReq);
- END psIO;
-
-
- (*------ Do something on response to a pressed Gadget ---------------------*)
-
- PROCEDURE HandleGadgetEvent(gad: I.GadgetPtr; code: INTEGER);
- BEGIN
- IF gad.gadgetID = 0 THEN
- DLd.LockAll(FALSE);
- ELSE
- IF gad.gadgetID<=DLp.Prefs.DriveNum THEN
- IF I.selected IN gad.flags THEN
- DLd.LckOne(DLp.drive[gad.gadgetID-1])
- ELSE
- DLd.UnLckOne(DLp.drive[gad.gadgetID-1])
- END;
- END;
- force := FALSE;
- END;
- END HandleGadgetEvent;
-
- (*------ Response to Menu-select ------------------------------------------*)
-
- PROCEDURE HandleMenuEvent(code: INTEGER);
-
- VAR
- item: I.MenuItemPtr;
-
- BEGIN
- WHILE (code # I.menuNull) AND ~ terminated DO
- item := I.ItemAddress(menu^, code);
- CASE sys.VAL(LONGINT,gt.MenuItemUserData(item)) OF
- menuLock : DLd.LockAll(FALSE); |
- menuUnlock : DLd.UnlockAll(FALSE); |
- menuNorm : DLd.NormAll(); |
- menuAbout : DLr.RequestNotify(DLs.GetString(DLs.MsgAbout),
- sys.ADR(about),
- DLs.GetString(DLs.MsgAllRightsReserved)); |
- menuHide : closewin := TRUE; |
- menuQuit : terminated := TRUE; quickquit := FALSE |
- ELSE END;
-
- code := item.nextSelect;
-
- END;
-
- END HandleMenuEvent;
-
- (*------ Lock all window-specific resources and open window ---------------*)
-
- PROCEDURE OpenWindow(hijackfront: BOOLEAN);
- VAR twidth : INTEGER;
- mysc : I.ScreenPtr;
- gadwidth: LONGINT;
-
- (*------ Starts Gadget-List and calls MakeGadget --------------------------*)
-
- PROCEDURE CreateAllGadgets(VAR glist: I.GadgetPtr;
- vi: e.APTR;
- topborder: INTEGER;
- mysc: I.ScreenPtr): BOOLEAN;
- BEGIN
- gad := gt.CreateContext(glist);
- ng.textAttr := mysc.font;
- ng.leftEdge := 8;
- ng.topEdge := topadd + topborder;
- ng.width := wwidth-15;
- ng.height := gheight + 2;
- ng.gadgetText := DLs.GetString(DLs.GadLockAll);
- ng.flags := LONGSET{};
- ng.gadgetID := 0;
- ng.visualInfo := vi;
- gad := gt.CreateGadget(gt.buttonKind, gad, ng, u.done);
-
- ng.flags := LONGSET{gt.placeTextRight};
- ng.height := gheight;
- ng.width := SHORT(gadwidth);
- FOR count := 1 TO DLp.Prefs.DriveNum DO
- MakeGad(DLp.drive[count-1]);
- END;
-
- RETURN gad#NIL;
-
- END CreateAllGadgets;
-
- (*---- Check and FailOut if FALSE + Unlock PubScreen! ----------------*)
- PROCEDURE CheckAndFail(test: BOOLEAN; error: ARRAY OF CHAR); (* $CopyArrays- *)
- BEGIN
- IF ~test THEN
- (* Save to call with mysc=NIL ! *) I.UnlockPubScreen(NIL,mysc);
- DLr.FailOut(error);
- END;
- END CheckAndFail;
-
- (*---- Swaps two INTEGER's ----------------------------------------------*)
- PROCEDURE SwapInt(VAR x,y: INTEGER);
- VAR s: INTEGER;
- BEGIN
- s := x;
- x := y;
- y := s;
- END SwapInt;
-
- (*---- Max of two INTEGER's ---------------------------------------------*)
- PROCEDURE Max(x,y: INTEGER):INTEGER;
- BEGIN
- IF x > y THEN RETURN(x) ELSE RETURN(y) END;
- END Max;
-
- (*---- Min of two INTEGER's ---------------------------------------------*)
- PROCEDURE Min(x,y: INTEGER):INTEGER;
- BEGIN
- IF x < y THEN RETURN(x) ELSE RETURN(y) END;
- END Min;
-
-
- BEGIN
- IF hijackfront THEN
- DLp.Buffer1 := "\o";
- mysc := MI.LockFrontPubScr(DLp.Buffer1);
- ELSE
- mysc := I.LockPubScreen(DLp.Prefs.PubScreen);
- END;
- IF mysc=NIL THEN mysc := I.LockPubScreen(NIL) END;
- CheckAndFail(mysc#NIL,"LockPubScreen()");
-
- font := g.OpenFont(mysc.font^);
- CheckAndFail(font#NIL,"OpenFont()");
-
- zoom[0] := DLp.Prefs.LeftEdgeZoomed;
- zoom[1] := DLp.Prefs.TopEdgeZoomed;
-
- gheight := mysc.font.ySize;
- IF gheight < 11 THEN gheight := 11 END;
-
- wwidth := g.TextLength(sys.ADR(mysc.rastPort),
- DLs.GetString(DLs.GadLockAll)^,
- s.Length(DLs.GetString(DLs.GadLockAll)^))+40;
- IF DLp.OSrelease3 THEN
- gadwidth := gheight;
- gadwidth := gadwidth * checkscal DIV 1024; (* Operation LONGINT *)
- ELSE
- gadwidth := 26;
- END;
- FOR count := 0 TO DLp.Prefs.DriveNum-1 DO
- twidth := g.TextLength(sys.ADR(mysc.rastPort),
- DLp.drive[count].PrintName,
- s.Length(DLp.drive[count].PrintName))
- + SHORT(gadwidth) + 30 ;
- IF twidth > wwidth THEN wwidth := twidth END;
- END; (* FOR *)
-
-
- vi := gt.GetVisualInfo(mysc,u.done);
- CheckAndFail(vi#NIL,"GetVisualInfo()");
-
- topborder := mysc.wBorTop + mysc.font.ySize;
-
- menu := gt.CreateMenus(myNewMenu,u.done);
- IF menu=NIL THEN DLr.FailOut("CreateMenus()") END;
- CheckAndFail(gt.LayoutMenus(menu, vi, gt.mnNewLookMenus, I.LTRUE, u.done),"LayoutMenus()");
-
- CheckAndFail(CreateAllGadgets(glist,vi,topborder,mysc),"CreateAllGadgets()");
- wheight:=(DLp.Prefs.DriveNum+1) * gheight + 2 * topadd + topborder + mysc.wBorBottom;
-
- zoom[2] := Min(DLd.maxTitles,DLp.Prefs.DriveNum)
- * Max(g.TextLength(sys.ADR(mysc.rastPort),"-",1),
- g.TextLength(sys.ADR(mysc.rastPort),"+",1))
- + 85;
-
- zoom[3] := topborder + 1;
-
- IF DLp.Prefs.OpenZoomed THEN
- SwapInt(zoom[2],wwidth);
- SwapInt(zoom[3],wheight);
- END;
-
- DLd.mywin := I.OpenWindowTagsA(NIL,
- I.waLeft, DLp.Prefs.LeftEdge,
- I.waTop, DLp.Prefs.TopEdge,
- I.waHeight,wheight,
- I.waWidth,wwidth,
- I.waScreenTitle, sys.ADR(scrtitle),
- I.waPubScreen, mysc,
- I.waGadgets, glist,
- I.waZoom, sys.ADR(zoom),
- I.waIDCMP, LONGSET{I.mouseButtons,
- I.refreshWindow,
- I.gadgetUp,
- I.menuPick,
- I.activeWindow,
- I.inactiveWindow,
- I.closeWindow,
- I.diskInserted,
- I.diskRemoved},
- I.waFlags, LONGSET{I.windowDrag,
- I.windowDepth,
- I.windowClose,
- I.newLookMenus},
- u.done);
- CheckAndFail(DLd.mywin#NIL,"OpenWindow()");
-
- (* Window is open and all important screen-datas are scanned, so
- it isn't necessary to keep the lock on the PubScreen *)
- I.UnlockPubScreen(NIL,mysc);
- DLr.yourwin := DLd.mywin;
- gt.RefreshWindow(DLd.mywin, NIL);
- IF I.SetMenuStrip(DLd.mywin, menu^) THEN END;
-
- windowopen := TRUE;
- DLd.CheckDrives(TRUE); (* force refresh *)
-
- END OpenWindow;
-
-
- (*------ Close window and unlock all window-specific resources ------------*)
-
- PROCEDURE CloseWindow();
- BEGIN
- windowopen := FALSE;
- DLr.yourwin := NIL;
- IF e.CheckIO(TimeReq)= NIL THEN e.AbortIO(TimeReq) END;
- IF DLd.mywin # NIL THEN
- I.ClearMenuStrip(DLd.mywin);
- I.CloseWindow(DLd.mywin); DLd.mywin := NIL;
- END;
- (* Save to call with NIL ! *) gt.FreeMenus(menu); menu := NIL;
- (* Save to call with NIL ! *) gt.FreeVisualInfo(vi); vi := NIL;
- (* Save to call with NIL ! *) gt.FreeGadgets(glist); glist := NIL;
- IF font # NIL THEN g.CloseFont(font); font := NIL END;
- IF e.WaitIO(TimeReq) = 0 THEN END;
- END CloseWindow;
-
-
- (***************************************************************************
- M A I N
- ***************************************************************************)
-
- BEGIN
-
- (*------ Open all necessary resources -------------------------------------*)
-
- IF (I.int.libNode.version<37) THEN HALT(20) END;
-
- OpenDev := topadd; (* DUMMY *)
-
- DLp.ReadArgs;
-
- terminated := FALSE;
- keepquit := FALSE;
-
- HotSig := hot.InitX(comName,comTitle,comDescr,{hot.notify},TRUE,SHORT(SHORT(DLp.Argv.pri^)));
- IF HotSig < 0 THEN HALT(0) END;
-
- myNewMenu := myNewMenuConst;
-
- DLs.FillMenu(myNewMenu);
-
- TimerPort := e.CreateMsgPort();
- IF TimerPort = NIL THEN DLr.FailOut("CreateMsgPort()") END;
-
- TimeReq := e.CreateIORequest(TimerPort,SIZE(t.TimeRequest));
- IF TimeReq = NIL THEN DLr.FailOut("CreateIORequest()") END;
-
- OpenDev := e.OpenDevice(t.timerName,t.vBlank,TimeReq,LONGSET{});
- IF OpenDev # 0 THEN
- DLr.FailOut("OpenDevice(Timer)")
- END;
-
- TimeReq.node.command := t.addRequest;
- TimeReq.node.error := 0;
-
- psIO;
- DLp.ReadPrefs;
- DLd.CheckDrivesInit;
- IF DLp.Prefs.OpenWindow THEN OpenWindow(FALSE) END;
- hot.Activate(TRUE);
-
- DLp.FreeArgs; (* everything checked, no longer needed *)
-
- (*------ Waiting for Messages (User, Timer) -------------------------------*)
-
- WHILE ~ terminated DO
-
- WHILE ~ terminated DO
-
- IF windowopen THEN
- IF e.CheckIO(TimeReq)#NIL THEN
- psIO;
- END;
- signals := e.Wait (LONGSET{DLd.mywin.userPort.sigBit,TimerPort.sigBit,HotSig,d.ctrlC});
- ELSE
- signals := e.Wait (LONGSET{TimerPort.sigBit,HotSig,d.ctrlC});
- END;
-
- IF windowopen AND (DLd.mywin.userPort.sigBit IN signals) THEN
- LOOP
- imsg := gt.GetIMsg(DLd.mywin.userPort);
- IF imsg=NIL THEN EXIT END;
- imsgClass := imsg.class;
- imsgCode := imsg.code;
- gad := imsg.iAddress;
- gt.ReplyIMsg(imsg);
- force := TRUE;
-
- IF I.activeWindow IN imsgClass THEN
- DLd.winactive := TRUE;
- force := FALSE;
- END;
-
- IF I.inactiveWindow IN imsgClass THEN
- DLd.winactive := FALSE
- END;
-
- IF I.refreshWindow IN imsgClass THEN
- gt.BeginRefresh(DLd.mywin);
- gt.EndRefresh(DLd.mywin, I.LTRUE);
- force := FALSE;
- END;
-
- IF I.gadgetUp IN imsgClass THEN
- HandleGadgetEvent(gad, imsgCode);
- END;
-
- IF I.menuPick IN imsgClass THEN
- HandleMenuEvent(imsgCode);
- END;
-
- IF I.closeWindow IN imsgClass THEN
- closewin := TRUE;
- END; (* IF *)
-
- DLd.CheckDrives(force);
-
- END; (* LOOP *)
- END; (* IF DLd.mywin *)
-
- IF closewin THEN
- closewin := FALSE;
- CloseWindow;
- END;
-
- IF HotSig IN signals THEN
- WHILE hot.GetCMsg(HotType,HotID) DO
- IF hot.hotkey IN HotType THEN
- CASE HotID OF
- DLp.lckallHot : DLd.LockAll(FALSE);
- IF DLp.Prefs.LockAllBeep THEN I.DisplayBeep(NIL) END;
- | DLp.normallHot : DLd.NormAll();
- IF DLp.Prefs.NormAllBeep THEN I.DisplayBeep(NIL) END;
- | DLp.gotofrontHot : IF windowopen THEN CloseWindow END;
- OpenWindow(TRUE);
- | DLp.opencloseHot : IF windowopen THEN CloseWindow
- ELSE OpenWindow(FALSE) END;
- ELSE
- IF DLp.Prefs.UnlockBeep THEN I.DisplayBeep(NIL) END;
- DLd.UnLckOne(DLp.drive[HotID-1]);
- END; (* CASE *)
- DLd.CheckDrives(TRUE);
- ELSIF hot.command IN HotType THEN
- CASE HotID OF
- hot.cAppear : IF windowopen THEN DLd.CheckDrives(TRUE)
- ELSE OpenWindow(FALSE) END;
- I.WindowToFront(DLd.mywin);
- I.ScreenToFront(DLd.mywin.wScreen);
- IF DLd.mywin.height = (topborder + 1)
- THEN I.ZipWindow(DLd.mywin) END;
- |hot.cDisappear: IF windowopen THEN CloseWindow END;|
- |hot.cKill : terminated := TRUE; quickquit := TRUE;
- |hot.cUnique : terminated := TRUE; quickquit := TRUE; keepquit := TRUE;
- ELSE
- END; (* CASE *)
- END; (* IF *)
- END; (* WHILE *)
- END; (* IF *)
-
- IF d.ctrlC IN signals THEN terminated := TRUE; quickquit := TRUE END;
-
- (* None of the above -> Msg by TIMER, mouseButtons *)
- DLd.CheckDrives(FALSE);
-
- END; (* WHILE *)
-
- IF (~ quickquit) AND DLd.OneLocked() THEN
- count := SHORT(DLr.RequestResponseNum(
- sys.ADR("DeviceLock"),
- DLs.GetString(DLs.MsgKeepUnlock),
- DLs.GetString(DLs.GadKeepUnlock),
- NIL));
- IF (count = 0) THEN
- terminated := FALSE;
- ELSIF (count = 1) THEN
- DLd.UnlockAll(TRUE);
- END;
- END;
-
- END; (* WHILE *)
-
- (***************************************************************************
- C L O S E
- ***************************************************************************)
-
- CLOSE
- IF (I.int.libNode.version>=37) THEN
- IF windowopen THEN
- CloseWindow
- ELSIF (TimeReq # NIL) THEN
- IF e.CheckIO(TimeReq)= NIL THEN e.AbortIO(TimeReq) END;
- IF e.WaitIO(TimeReq) = 0 THEN END;
- END;
- IF (quickquit AND (~ keepquit)) OR (ol.Result > 0) THEN
- IF DLp.drive # NIL THEN DLd.UnlockAll(TRUE); END
- END;
- IF OpenDev = 0 THEN e.CloseDevice(TimeReq) END;
- (* Save to call with NIL ! *) e.DeleteIORequest(TimeReq);
- (* Save to call with NIL ! *) e.DeleteMsgPort(TimerPort);
- END;
- IF (ol.Result > 0) THEN I.DisplayBeep(NIL) END;
-
- END DeviceLock.
-